perm filename SCSPH.CH[UHF,DEK] blob sn#841771 filedate 1987-06-18 generic text, type T, neo UTF8
% changes for SDTONE.WEB to enhance contrasts
% Change file for SDTONE.WEB, computes a "sphere"
@x
reset(bytes_in,input_name,'/B:8')
@y
@z
@x
@!new_row:array[-3..nn+4] of real; {densities in row being input}
@y
@!new_row:array[-3..nn+4] of real; {densities in row being input}
@!row_buf:array[0..2,0..nn+1] of real; {`actual' data before enhancement}
@z
@x
@!t:eight_bits; {byte of input}
begin for j←-3 to 0 do new_row[j]←0.0;
if i>mm then for j←1 to nn do new_row[j]←0.0
else for j←1 to nn do
	begin read(bytes_in,t); new_row[j]←(255.5-t)/256.0;
	end;
@y
@!x,@!y,@!z:real; {coordinates of input}
begin if i=1 then
	begin for j←1 to nn do row_buf[2,j]←(1250+j*j)/1000000;
	row_buf[2,0]←row_buf[2,1]; row_buf[2,nn+1]←row_buf[2,nn];
	for j←0 to nn+1 do row_buf[1,j]←row_buf[2,j];
	end;
for j←0 to nn+1 do
	begin row_buf[0,j]←row_buf[1,j]; row_buf[1,j]←row_buf[2,j];
	end;
if i<mm then
	begin for j←1 to nn do
		begin x←(i-119)/111.5; y←(j-120)/111.5; z←1.0-x*x-y*y;
		if z<0.0 then row_buf[2,j]←(1250*(i+1)+j*j)/1000000
		else row_buf[2,j]←(9+x-4*y-8*sqrt(z))/18.0;
		end;
	row_buf[2,0]←row_buf[2,1]; row_buf[2,nn+1]←row_buf[2,nn];
	end;
for j←-3 to 0 do new_row[j]←0.0;
for j←1 to nn do new_row[j]←9*row_buf[1,j]-row_buf[0,j-1]-row_buf[0,j]
 -row_buf[0,j+1]-row_buf[1,j-1]-row_buf[1,j+1]-row_buf[2,j-1]
 -row_buf[2,j]-row_buf[2,j+1];
@z